(** This module provides functions to create "binary" buffers of JVM class files represented in 'jvm_bytecode.ml'.
 
 Those buffers can either be sent along to 'jvm_jar.ml' to bundle them together or back to this module
 to save them to disk.
 Note : it is considered a wanted design choice that this modules depends heavily on 'jvm_bytecode.ml'. They are
 essentially only seperated for maintanace reasons. Mentally they should be thought of as one, whereas 'jvm_bytecode.ml' deals with the more
 abstract ocaml representation of the class file format and 'jvm_classfile.ml' deals with the actual file IO.
 
 @author Oliver Jan Krylow 2010
 *)

open Jvm_bytecode
open ExtList

(** jvm bytecode types -> types for the jvm class file format Note: the     
 signed byte types are as far as I can see only used for switch opcodes, 
 but even there not really necessary, I leave them nonetheless for       
 potential future use or backward compatability, in case someone         
 implements it ^^                                                        *)
type t =
	| U1 of int (** 8bit unsigned big endian byte  -> jvm class file opcode size *)
	| U2 of int (** 16bit unsigned big endian *)
	| S2 of int (** '' signed '' *)
	| U4 of int64 (** 32bit unsigned big endian *)
	| S4 of int32 (** '' signed '' *)

type stream = t list

(** this exception indicates, that too large numbers were used. *)
exception ByteCodeOverflow of string
exception Unimplemented

(** little helper function to make code cleaner.
  *)
let flatmap f l = (List.flatten (List.map f l)) 

let create_dir path =
	print_endline ("Creating '" ^ path ^ "'.");
	let oldcwd = Unix.getcwd() in
	
	List.iter
	(fun dir -> 
		if dir <> "" then
		( print_endline (" Making and changing into '" ^ dir ^ "'.");
		(try Unix.mkdir dir 0o740 with Unix.Unix_error(Unix.EEXIST,_,_) -> print_endline ("'" ^ dir ^ "' already exists. Skipping making."));
		Unix.chdir dir))
	(ExtString.String.nsplit path Filename.dir_sep);
	
	print_endline ("Getting back to '" ^ oldcwd ^ "'.");
	Unix.chdir oldcwd 

(**  *)
let asU1 i =
	if i < 0 then raise ( ByteCodeOverflow "negative" ) else
	if i > 255 then raise ( ByteCodeOverflow "positive" ) else
		U1 i

let asU2 i =
	if i < 0 then raise ( ByteCodeOverflow "negative" ) else
	if i > 65535 then raise ( ByteCodeOverflow "positive" ) else
		U2 i

let asU4 i =
	if i < 0L then raise ( ByteCodeOverflow "negative" ) else
	if i > 4294967295L then raise ( ByteCodeOverflow "positive" ) else
		U4 i

let bytesplit i n =
	match n with
			| 0 -> asU1 (i land 0xF)
			| 1 -> asU1 (i lsr 8)
			| 2 -> asU1 (i lsr 16)
			| 3 -> asU1 (i lsr 24)
			| _ -> raise Unimplemented

let bytesplit32 i n =
	match n with
			| 0 -> asU1 (Int32.to_int ( Int32.logand i 0xFl ))
			| 1 -> asU1 (Int32.to_int ( Int32.shift_right_logical i 8 ))
			| 2 -> asU1 (Int32.to_int ( Int32.shift_right_logical i 16 ))
			| 3 -> asU1 (Int32.to_int ( Int32.shift_right_logical i 24 ))
			| _ -> raise Unimplemented

let asUTF8mod str =
	List.flatten (
			List.of_enum (
					Enum.map (
							fun ch ->
									let unicode = UChar.uint_code (UChar.of_char ch) in
									if (unicode >= 0x0001) && (unicode <= 0x007F) then [ U1 unicode ]
									
									else if (unicode = 0) || (unicode >= 0x0080) && (unicode <= 0x07FF) then
										[ U1 (0x00C0 lor (unicode lsr 6)); U1 (0x0080 lor (unicode land 0x003F)) ]
									
									else if (unicode >= 0x0800) && (unicode <= 0xFFFF) then
										[ U1 (0x00E0 lor (unicode lsr 12)); U1 (0x0080 lor ((unicode lsr 6) land 0x003F)); U1 (0x0080 lor (unicode land 0x003F)) ]
									
									else
										[ U1 0x00ED; U1 (0x00A0 lor (((unicode lsr 16) - 1) land 0x000F)) ; U1 (0x0080 lor ((unicode lsr 10) land 0x003F)); U1 0x00ED; U1 (0x00B0 lor ((unicode lsr 6) land 0x000F)); U1 (0x0080 lor (unicode land 0x003F)) ]
						)
						(ExtString.String.enum str)))

let rec merge_flags flags_list =
	let merge_access_masks flag1 flag2 = flag1 land flag2
	in U2 (List.fold_left merge_access_masks 0x0000 (List.map flag_to_int flags_list))

and flag_to_int = function
	| Public -> 0x0001
	| Private -> 0x0002
	| Protected -> 0x0004
	| Static -> 0x0008
	| Final -> 0x0010
	| Super -> 0x0020
	| Synchronized -> 0x0020
	| Volatile | Bridge -> 0x0040
	| Transient | Varargs -> 0x0080
	| Native -> 0x0100
	| Interface -> 0x0200
	| Abstract -> 0x0400
	| Strict -> 0x0800
	| Synthetic -> 0x1000
	| Annotation -> 0x2000
	| Enum -> 0x4000

let count_bytes bytes_list =
	(let qualify = function
			| U1 _ -> 1
			| U2 _ | S2 _ -> 2
			| U4 _ | S4 _ -> 4
		in List.fold_left (fun a b -> a + (qualify b)) 0 bytes_list )

exception IllegalWideArg of opcode
exception IllegalChop of int * int
exception IllegalAppend of int * int * verification_type_info list
exception DeprecatedOpcode of opcode

(* takes one abstract jvm class file and returns list of bc typed integers *)
(* TODO:change the limit of lists in ocaml is around 10000 elements, which*)
(* is too small considering we are storing bytes.*)
(* Right now a list of bytes is not stricly necessary for our compiler,*)
(* so we could write directly to outbut buffer in this function.*)
(* Or change collection type to something like big array...*)
let rec streamify jclass =
	[U4 0xCAFEBABEL ]
	
	@ (match jclass.version with
				| JDK_1_1 -> raise Unimplemented (* [ U2 0x3 ;U2 0x002D ] *)
				| JDK_1_2 -> raise Unimplemented (* [ U2 0x0 ;U2 0x002E ] *)
				| JDK_1_3 -> raise Unimplemented (* [ U2 0x0 ;U2 0x002F ] *)
				| JDK_1_4 -> raise Unimplemented (* [ U2 0x0 ;U2 0x0030 ] *)
				| JDK_1_5 -> raise Unimplemented (* [ U2 0x0 ;U2 0x0031 ] *)
				| JDK_1_6 -> [ U2 0x0 ; U2 0x0032 ]
				| JDK_1_7 -> raise Unimplemented (*[ U2 0x0 ;U2 0x0033 ] *) )
	
	@ [ asU2 ((DynArray.length jclass.constant_pool) + 1) ]
	@ (let streamify_cp = function
			| Utf8Const str ->
					[ U1 0x1 ] @ (asUTF8mod str)
			
			| IntegerConst i -> [ U1 0x3; asU4 (Int64.of_int32 i) ]
			| FloatConst flo -> [ U1 0x4; asU4 (Int64.bits_of_float flo)]
			| LongConst i -> [ U1 0x5; asU4 (Int64.logand 0x00000000FFFFFFFFL i); asU4 (Int64.shift_right_logical i 32) ]
			| DoubleConst flo ->
					[ U1 0x6 ; asU4 (Int64.logand 0x00000000FFFFFFFFL (Int64.bits_of_float flo)) ; asU4 (Int64.shift_right_logical (Int64.bits_of_float flo) 32) ]
			| StringConst i -> [ U1 0x8; asU2 i ]
			| Class name_index -> [ U1 0x7; asU2 name_index ]
			| FieldRef (class_index, name_type_index) -> [ U1 0x9 ; asU2 class_index; asU2 name_type_index ]
			| MethodRef (class_index, name_type_index) -> [ U1 0x10; asU2 class_index; asU2 class_index ]
			| InterfaceMethodRef (class_index, name_type_index) -> [ U1 0x11; asU2 class_index; asU2 name_type_index ]
			| NameAndType (name_index, descriptor_index) -> [ U1 0x12; asU2 name_index; asU2 descriptor_index ]
		in flatmap streamify_cp (DynArray.to_list jclass.constant_pool) )
	
	@ [ merge_flags jclass.access_flags ]
	
	@ [ asU2 jclass.this ]
	
	@ [ asU2 jclass.super ]
	
	@ [ asU2 (List.length jclass.interfaces) ]
	
	@ ( List.map (fun i -> asU2 i) jclass.interfaces)
	
	@ [ asU2 (List.length jclass.fields) ]
	
	@ flatmap (fun f -> [merge_flags f.f_access_flags;
					asU2 f.f_name_index;
					asU2 f.f_descriptor_index;
					asU2 (List.length f.f_attributes)]
					@ flatmap streamify_attrs f.f_attributes) jclass.fields
	
	@ [ asU2 (List.length jclass.methods) ]
	
	@ flatmap (fun m -> [merge_flags m.m_access_flags;
					asU2 m.m_name_index;
					asU2 m.m_descriptor_index;
					asU2 (List.length m.m_attributes)]
					@ flatmap streamify_attrs m.m_attributes) jclass.methods
	
	@ [ asU2 (List.length jclass.attributes) ]
	
	@ flatmap streamify_attrs jclass.attributes

and streamify_verification = function
	| Top_var -> [ U1 0x00 ]
	| Integer_var -> [ U1 0x01 ]
	| Float_var -> [ U1 0x02 ]
	| Long_var -> [U1 0x03 ; U1 0x00 ]
	| Double_var -> [ U1 0x04 ; U1 0x00]
	| Null_var -> [ U1 0x05 ]
	| UninitializedThis_var -> [ U1 0x06 ]
	| Object_var index -> [ U1 0x07 ; asU2 index]
	| Uninitialized_var offset -> [ U1 0x08 ; asU2 offset]

and streamify_entry = function
	| Same offset_delta ->
			if (offset_delta < 0) || (offset_delta > 63) then [ U1 0xFB; asU2 offset_delta ] else [ U1 offset_delta]
	
	| SameLocals1 (offset_delta, verification) ->
			if (offset_delta < 0) || (offset_delta > 63) then [ U1 0xF7; asU2 offset_delta ] else [U1 (offset_delta + 64) ]
				
				@ streamify_verification verification
	
	| Chop (offset_delta, num) ->
			if (251 - num < 248) || (251 - num > 250) then (raise (IllegalChop (offset_delta, num))) else [U1 (251 - num); asU2 offset_delta]
	
	| Append (offset_delta, num, verifications) ->
			if (251 + num < 252) || (251 + num > 254) then (raise (IllegalAppend (offset_delta, num, verifications))) else [ U1 (251 + num); asU2 offset_delta ]
				
				@ if ((List.length verifications) != num) then (raise (IllegalAppend (offset_delta, num, verifications))) else flatmap streamify_verification verifications
	
	| Full (offset_delta, locals_verifications, stack_items) ->
			[ U1 0xFF; asU2 offset_delta; asU2 (List.fold_left (fun a ver ->
									a + (match ver with Top_var | Integer_var | Float_var | Null_var
												| UninitializedThis_var | Object_var _ | Uninitialized_var _ -> 1
												| Double_var | Long_var -> 2)) 0 locals_verifications) ]
			
			@ flatmap streamify_verification locals_verifications
			
			@ [ asU2 (List.fold_left (fun a ver -> a + (match ver with Top_var | Integer_var | Float_var | Null_var
												| UninitializedThis_var | Object_var _ | Uninitialized_var _ -> 1
												| Double_var | Long_var -> 2)) 0 stack_items) ]
			
			@ flatmap streamify_verification stack_items

and streamify_attrs = function
	| ConstantValue i -> [ U2 0x0011 ; U4 0x00000002L ; asU2 i ]
	| Code code ->
			[U2 0x0012; asU4 (Int64.of_int ( 12 + count_bytes (flatmap streamify_opcode code.co_code) +
							((List.length code.co_exceptions) * 8) + count_bytes (flatmap streamify_attrs code.co_attributes)) );
			asU2 code.co_max_stack; asU2 code.co_max_locals;
			asU4 (Int64.of_int (count_bytes (flatmap streamify_attrs code.co_attributes)))]
			
			@ flatmap streamify_opcode code.co_code
			
			@ [asU2 (List.length code.co_exceptions)]
			
			@ (List.flatten (let streamify_exceptions e = [ asU2 e.ex_start_pc; asU2 e.ex_end_pc; asU2 e.ex_handler_pc; asU2 e.ex_catch_type ]
						in List.map streamify_exceptions code.co_exceptions))
			
			@ [asU2 (List.length code.co_attributes)]
			
			@ flatmap streamify_attrs code.co_attributes
	
	| StackMap stackmap -> [U2 0x0013; asU4 (Int64.of_int (2 + (count_bytes (flatmap streamify_entry stackmap))))]
			@ flatmap streamify_entry stackmap
	
	| Exceptions exep ->
			[ U2 0x0014; asU4 (Int64.of_int (2 + (2 * (List.length exep)))); asU2 (List.length exep) ] @ (List.map (fun e -> asU2 e) exep)
	
	| InnerClasses inner ->
			[U2 0x0015; asU4 (Int64.of_int (2 + (8 * (List.length inner)))); asU2 (List.length inner)]
			@ flatmap (fun cl -> [ asU2 cl.inner_class_index; asU2 cl.outer_class_index; asU2 cl.inner_name_index; merge_flags cl.inner_access_flags ]) inner
	
	| EnclosingMethod (host, meth) -> [ U2 0x0016; U4 0x4L; asU2 host; asU2 meth ]
	| SyntheticAttr -> [ U2 0x0017; U4 0x0L ]
	| SignatureAttr i -> [ U2 0x0018; U4 0x2L; asU2 i ]
	| SourceFile i -> [ U2 0x0019; U4 0x2L; asU2 i ]
	| SourceDebug data -> [ U2 0x001A ; asU4 (Int64.of_int (List.length (asUTF8mod data))) ] @ (asUTF8mod data)
	
	| LineNumbers numbers ->
			[ U2 0x001B; asU4 (Int64.of_int (2 + (4 * (List.length numbers)))); asU2 (List.length numbers) ]
			@ flatmap (fun (start_pc, line_number) -> [ asU2 start_pc; asU2 line_number ]) numbers
	
	| LocalVariables vars ->
			[ U2 0x001C; asU4 (Int64.of_int (2 + (10 * (List.length vars)))); asU2 (List.length vars) ]
			@ flatmap (fun var -> [ asU2 var.start_pc; asU2 var.length; asU2 var.name_index; asU2 var.des_sig_index; asU2 var.index ]) vars
	
	| LocalVariablesType types ->
			[ U2 0x001D; asU4 (Int64.of_int (2 + (10 * (List.length types)))); asU2 (List.length types) ]
			@ flatmap (fun var -> [ asU2 var.start_pc; asU2 var.length; asU2 var.name_index; asU2 var.des_sig_index; asU2 var.index ]) types
	
	| Deprecated -> [ U2 0x001E; U4 0L ]
	| RuntimeVisibleAnnotations -> raise Unimplemented
	| RuntimeInvisibleAnnotations -> raise Unimplemented
	| RuntimeVisibleParameterAnnotations -> raise Unimplemented
	| RuntimeInvisibleParameterAnnotations -> raise Unimplemented
	| AnnotationDefault -> raise Unimplemented

and streamify_opcode = function
	| AaLoad -> [U1 0x32]
	| BaLoad -> [U1 0x33]
	| CaLoad -> [U1 0x34]
	| DaLoad -> [U1 0x31]
	| FaLoad -> [U1 0x30]
	| IaLoad -> [U1 0x2E]
	| LaLoad -> [U1 0x2F]
	| SaLoad -> [U1 0x35]
	| Aload i -> [U1 0x19; asU1 i]
	| Aload_0 -> [U1 0x2A]
	| Aload_1 -> [U1 0x2B]
	| Aload_2 -> [U1 0x2C]
	| Aload_3 -> [U1 0x2D]
	| Dload i -> [U1 0x18; asU1 i]
	| Dload_0 -> [U1 0x26]
	| Dload_1 -> [U1 0x27]
	| Dload_2 -> [U1 0x28]
	| Dload_3 -> [U1 0x29]
	| Fload i -> [U1 0x17 ; asU1 i]
	| Fload_0 -> [U1 0x22]
	| Fload_1 -> [U1 0x23]
	| Fload_2 -> [U1 0x24]
	| Fload_3 -> [U1 0x24]
	| Iload i -> [U1 0x15; asU1 i]
	| Iload_0 -> [U1 0x1A]
	| Iload_1 -> [U1 0x1B]
	| Iload_2 -> [U1 0x1C]
	| Iload_3 -> [U1 0x1D]
	| Lload i -> [U1 0x16; asU1 i]
	| Lload_0 -> [U1 0x1E]
	| Lload_1 -> [U1 0x1F]
	| Lload_2 -> [U1 0x20]
	| Lload_3 -> [U1 0x21]
	| AaStore -> [U1 0x53]
	| BaStore -> [U1 0x54]
	| CaStore -> [U1 0x55]
	| DaStore -> [U1 0x52]
	| FaStore -> [U1 0x51]
	| IaStore -> [U1 0x4F]
	| LaStore -> [U1 0x50]
	| SaStore -> [U1 0x56]
	| Astore i -> [U1 0x3A; asU1 i]
	| Astore_0 -> [U1 0x4B]
	| Astore_1 -> [U1 0x4C]
	| Astore_2 -> [U1 0x4D]
	| Astore_3 -> [U1 0x4E]
	| Dstore i -> [U1 0x39; asU1 i]
	| Dstore_0 -> [U1 0x47]
	| Dstore_1 -> [U1 0x48]
	| Dstore_2 -> [U1 0x49]
	| Dstore_3 -> [U1 0x4A]
	| Fstore i -> [U1 0x38; asU1 i]
	| Fstore_0 -> [U1 0x43]
	| Fstore_1 -> [U1 0x44]
	| Fstore_2 -> [U1 0x45]
	| Fstore_3 -> [U1 0x46]
	| Istore i -> [U1 0x36; asU1 i]
	| Istore_0 -> [U1 0x3B]
	| Istore_1 -> [U1 0x3C]
	| Istore_2 -> [U1 0x3D]
	| Istore_3 -> [U1 0x3E]
	| Lstore i -> [U1 0x37; asU1 i]
	| Lstore_0 -> [U1 0x3F]
	| Lstore_1 -> [U1 0x40]
	| Lstore_2 -> [U1 0x41]
	| Lstore_3 -> [U1 0x42]
	| AconstNull -> [U1 0x1]
	| AnewArray i -> [U1 0xBD; bytesplit i 1; bytesplit i 0]
	| Areturn -> [U1 0xB0]
	| Dreturn -> [U1 0xAF]
	| Freturn -> [U1 0xAE]
	| Ireturn -> [U1 0xAC]
	| Lreturn -> [U1 0xAD]
	| Return -> [U1 0xB1]
	| ArrayLength -> [U1 0xBE]
	| Athrow -> [U1 0xBF]
	| BiPush i -> [U1 0x10; asU1 i]
	| SiPush i -> [U1 0x11; bytesplit i 1; bytesplit i 0]
	| Swap -> [U1 0x5F]
	| CheckCast i -> [U1 0xC0; bytesplit i 1; bytesplit i 0]
	| D2f -> [U1 0x90]
	| D2i -> [U1 0x8E]
	| D2l -> [U1 0x8F]
	| F2d -> [U1 0x8D]
	| F2i -> [U1 0x8B]
	| F2l -> [U1 0x8C]
	| I2b -> [U1 0x91]
	| I2c -> [U1 0x92]
	| I2d -> [U1 0x87]
	| I2f -> [U1 0x86]
	| I2l -> [U1 0x85]
	| I2s -> [U1 0x93]
	| L2d -> [U1 0x8A]
	| L2f -> [U1 0x89]
	| L2i -> [U1 0x88]
	| Dadd -> [U1 0x63]
	| Fadd -> [U1 0x62]
	| Iadd -> [U1 0x60]
	| Ladd -> [U1 0x61]
	| Dcmpg -> [U1 0x98]
	| Dcmpl -> [U1 0x97]
	| Fcmpg -> [U1 0x96]
	| Fcmpl -> [U1 0x95]
	| Lcmp -> [U1 0x94]
	| IfAcompeq i -> [U1 0xA5; bytesplit i 1; bytesplit i 0]
	| IfAcompne i -> [U1 0xA6; bytesplit i 1; bytesplit i 0]
	| IfIcompeq i -> [U1 0x9F; bytesplit i 1; bytesplit i 0]
	| IfIcompne i -> [U1 0xA0; bytesplit i 1; bytesplit i 0]
	| IfIcomplt i -> [U1 0xA1; bytesplit i 1; bytesplit i 0]
	| IfIcomple i -> [U1 0xA4; bytesplit i 1; bytesplit i 0]
	| IfIcompgt i -> [U1 0xA2; bytesplit i 1; bytesplit i 0]
	| IfIcompge i -> [U1 0xA3; bytesplit i 1; bytesplit i 0]
	| Ifeq i -> [U1 0x99; bytesplit i 1; bytesplit i 0]
	| Ifne i -> [U1 0x9A; bytesplit i 1; bytesplit i 0]
	| Iflt i -> [U1 0x9B; bytesplit i 1; bytesplit i 0]
	| Ifle i -> [U1 0x9E; bytesplit i 1; bytesplit i 0]
	| Ifgt i -> [U1 0x9D; bytesplit i 1; bytesplit i 0]
	| Ifge i -> [U1 0x9C; bytesplit i 1; bytesplit i 0]
	| IfNonNull i -> [U1 0xC7; bytesplit i 1; bytesplit i 0]
	| IfNull i -> [U1 0xC6; bytesplit i 1; bytesplit i 0]
	| Dconst_0 -> [U1 0xE]
	| Dconst_1 -> [U1 0xF]
	| Fconst_0 -> [U1 0xB]
	| Fconst_1 -> [U1 0xC]
	| Fconst_2 -> [U1 0xD]
	| Iconst_m1 -> [U1 0x2]
	| Iconst_0 -> [U1 0x3]
	| Iconst_1 -> [U1 0x4]
	| Iconst_2 -> [U1 0x5]
	| Iconst_3 -> [U1 0x6]
	| Iconst_4 -> [U1 0x7]
	| Iconst_5 -> [U1 0x8]
	| Lconst_0 -> [U1 0x9]
	| Lconst_1 -> [U1 0xA]
	| Ddiv -> [U1 0x6F]
	| Fdiv -> [U1 0x6E]
	| Idiv -> [U1 0x6C]
	| Ldiv -> [U1 0x6D]
	| Dmul -> [U1 0x6B]
	| Fmul -> [U1 0x6A]
	| Imul -> [U1 0x68]
	| Lmul -> [U1 0x69]
	| Dneg -> [U1 0x77]
	| Fneg -> [U1 0x76]
	| Ineg -> [U1 0x74]
	| Lneg -> [U1 0x75]
	| Drem -> [U1 0x73]
	| Frem -> [U1 0x72]
	| Irem -> [U1 0x70]
	| Lrem -> [U1 0x71]
	| Dsub -> [U1 0x67]
	| Fsub -> [U1 0x66]
	| Isub -> [U1 0x64]
	| Lsub -> [U1 0x65]
	| Dup -> [U1 0x59]
	| Dup_x1 -> [U1 0x5A]
	| Dup_x2 -> [U1 0x5B]
	| Dup2 -> [U1 0x5C]
	| Dup2_x1 -> [U1 0x5D]
	| Dup2_x2 -> [U1 0x5E]
	| GetField i -> [U1 0xB4; bytesplit i 1; bytesplit i 0]
	| GetStatic i -> [U1 0xB2; bytesplit i 1; bytesplit i 0]
	| Goto i -> [U1 0xA7; bytesplit i 1; bytesplit i 0 ]
	| Goto_w i -> [U1 0xC8; bytesplit i 3; bytesplit i 2; bytesplit i 1; bytesplit i 0]
	| Iand -> [U1 0x7E]
	| Land -> [U1 0x7F]
	| Ior -> [U1 0x80]
	| Ixor -> [U1 0x82]
	| Lor -> [U1 0x81]
	| Lxor -> [U1 0x83]
	| Iinc (i , const) -> [U1 0x84; asU1 i; asU1 const]
	| InstanceOf i -> [U1 0xC1; bytesplit i 1; bytesplit i 0]
	| InvokeInterface (i , count) -> [U1 0xB9; bytesplit i 1; bytesplit i 0 ; asU1 count; U1 0]
	| InvokeSpecial i -> [U1 0xB7 ; bytesplit i 1; bytesplit i 0]
	| InvokeStatic i -> [U1 0xB8; bytesplit i 1; bytesplit i 0]
	| InvokeVirtual i -> [U1 0xB6; bytesplit i 1; bytesplit i 0]
	| InvokeDynamic -> raise Unimplemented
	| Ishl -> [U1 0x78]
	| Ishr -> [U1 0x7A]
	| Iushr -> [U1 0x7C]
	| Lshl -> [U1 0x79]
	| Lshr -> [U1 0x7B]
	| Lushr -> [U1 0x7D]
	| Jsr i -> raise (DeprecatedOpcode (Jsr i))(*[U1 0xA8; bytesplit i 1; bytesplit i 0]*) (*DEPRACATED*)
	| Jsr_w i -> raise (DeprecatedOpcode (Jsr_w i))(*[U1 0xC9; bytesplit i 3; bytesplit i 2; bytesplit i 1; bytesplit i 0]*) (*DEPRACATED*)
	| Ldc i -> [U1 0x12; asU1 i]
	| Ldc_w i -> [U1 0x13; bytesplit i 1; bytesplit i 0]
	| Ldc2_w i -> [U1 0x14; bytesplit i 1; bytesplit i 0]
	| LookupSwitch (default , pairs ) -> (* WARNING: 0-3 byte padding needs to be inserted depending on position in code array *)
			[U1 0xAB; bytesplit (List.length pairs) 3; bytesplit (List.length pairs) 2; bytesplit (List.length pairs) 1; bytesplit (List.length pairs) 0]
			
			@ (let split_pairs (a, b) = [ bytesplit32 a 3; bytesplit32 a 2; bytesplit32 a 1; bytesplit32 a 0; bytesplit32 b 3;
					bytesplit32 b 2; bytesplit32 b 1; bytesplit32 b 0 ] in flatmap split_pairs pairs)
	
	| TableSwitch (default , low , high , offsets) ->
			[U1 0xAA ; bytesplit32 default 3; bytesplit32 default 2; bytesplit32 default 1; bytesplit32 default 0;
			bytesplit32 low 3; bytesplit32 low 2; bytesplit32 low 1; bytesplit32 low 0;
			bytesplit32 high 3; bytesplit32 high 2; bytesplit32 high 1 ; bytesplit32 high 0]
			
			@ (let split_offset n = [ bytesplit32 n 3; bytesplit32 n 2; bytesplit32 n 1; bytesplit32 n 0 ]
				in flatmap split_offset offsets)
	
	| MonitorEnter -> [U1 0xC2]
	| MonitorExit -> [U1 0xC3]
	| MultiNewArray (i , dimension) -> [U1 0xC5; bytesplit i 1; bytesplit i 0; asU1 dimension]
	| NewArray a ->
			[U1 0xBC; (match a with TBoolean -> U1 0x4 | TChar -> U1 0x5 | TFloat -> U1 0x6 | TDouble -> U1 0x7 | TByte -> U1 0x8 | TShort -> U1 0x9 | TInt -> U1 0x10 | TLong -> U1 0x11) ]
	| New i -> [U1 0xBB; bytesplit i 1; bytesplit i 0]
	| NoOp -> [U1 0x0]
	| Pop -> [U1 0x57]
	| Pop2 -> [U1 0x58]
	| PutField i -> [U1 0xB5; bytesplit i 1; bytesplit i 0]
	| PutStatic i -> [U1 0xB3; bytesplit i 1; bytesplit i 0]
	| Ret i -> raise (DeprecatedOpcode (Ret i))(*[U1 0xA9; asU1 i]*)
	| Wide op -> List.flatten [[U1 0xC4];
				(match op with
							| Iload i -> [U1 0x15; bytesplit i 1; bytesplit i 0]
							| Fload i -> [U1 0x17 ; bytesplit i 1; bytesplit i 0]
							| Aload i -> [U1 0x19 ; bytesplit i 1; bytesplit i 0]
							| Lload i -> [U1 0x16 ; bytesplit i 1; bytesplit i 0]
							| Dload i -> [U1 0x18; bytesplit i 1; bytesplit i 0]
							| Istore i -> [U1 0x36; bytesplit i 1; bytesplit i 0]
							| Fstore i -> [U1 0x38; bytesplit i 1; bytesplit i 0]
							| Astore i -> [U1 0x3A; bytesplit i 1; bytesplit i 0]
							| Lstore i -> [U1 0x37; bytesplit i 1; bytesplit i 0]
							| Dstore i -> [U1 0x39; bytesplit i 1; bytesplit i 0]
							| Ret i -> [U1 0xA9; bytesplit i 1; bytesplit i 0]
							| Iinc (i , const) -> [U1 0x84; bytesplit i 1; bytesplit i 0; bytesplit const 1; bytesplit const 0]
							| illegal -> raise (IllegalWideArg illegal)
				)]

(* Convert abstract bc type into hard binary form and push it into         *)
(* output_channel oc                                                       *)
let binarize oc byte_type =
	(match byte_type with
			| U1 i -> output_byte oc i
			
			| U2 i | S2 i ->
				let b0 = (i lsr 8) land 0xFF in
  				let b1 = i land 0xFF in
  				output_byte oc b0;
  				output_byte oc b1

			| U4 l ->
					let b0 = Int64.logand (Int64.shift_right_logical l 24) 0xFFL in
					let b1 = Int64.logand (Int64.shift_right_logical l 16) 0xFFL in
					let b2 = Int64.logand (Int64.shift_right_logical l 8) 0xFFL in
					let b3 = Int64.logand l 0xFFL in
					output_byte oc (Int64.to_int b0);
					output_byte oc (Int64.to_int b1);
					output_byte oc (Int64.to_int b2);
					output_byte oc (Int64.to_int b3)
			
			| S4 l -> 
				let b0 = Int32.logand (Int32.shift_right_logical l 24) 0xFFl in
				let b1 = Int32.logand (Int32.shift_right_logical l 16) 0xFFl in
				let b2 = Int32.logand (Int32.shift_right_logical l 8) 0xFFl in
				let b3 = Int32.logand l 0xFFl in
				output_byte oc (Int32.to_int b0);
				output_byte oc (Int32.to_int b1);
				output_byte oc (Int32.to_int b2);
				output_byte oc (Int32.to_int b3))

(* convert input_channel containing a class file to Jvm_bytecode.t *)
let classify ic = (raise Unimplemented)

exception IllegalDebinarize of string

(*TODO:substitue input_byte with small function that handels errors and blah! *)

let debinarize ic byte_id = 
	(match byte_id with
			| "U1" -> U1 (input_byte ic) 
			| "U2" -> U2 (((input_byte ic) lsl 8) lor (input_byte ic)) 
			| "U4" ->
					let b0 = (Int64.shift_left (Int64.of_int (input_byte ic)) 24) in
					let b1 = (Int64.shift_left (Int64.of_int (input_byte ic)) 16) in
					let b2 = (Int64.shift_left (Int64.of_int (input_byte ic)) 8) in
					let b3 = (Int64.of_int (input_byte ic)) in
					U4 ( Int64.logand b3 (Int64.logand b2 (Int64.logand b1 b0)) ) ;
			
			| "S2" -> 
				S2 (let b = input_byte ic in
  					if b < 32768 then b else b - 65536)
					 
			| "S4" -> 
				let b0 = (Int32.shift_left (Int32.of_int (input_byte ic)) 24) in
				let b1 = (Int32.shift_left (Int32.of_int (input_byte ic)) 16) in
				let b2 = (Int32.shift_left (Int32.of_int (input_byte ic)) 8) in
				let b3 = (Int32.of_int (input_byte ic)) in
				S4 ( Int32.logand b3 (Int32.logand b2 (Int32.logand b1 b0)) ) ;
			
			| unsupported -> raise (IllegalDebinarize unsupported) )

exception ClassfileWithoutName of Jvm_bytecode.t

(**

*)
let write_bytecode outdir classfile = 
	let stream = streamify classfile  in
	let fileName =
		(if ExtString.String.ends_with outdir Filename.dir_sep 
		then Filename.chop_suffix outdir Filename.dir_sep
		else outdir) 
		^ ( match ( Jvm_bytecode.get classfile.constant_pool classfile.this ) 
			with Utf8Const str -> str 
			| _ -> raise (ClassfileWithoutName classfile) ) 
		^ ".class" 
	in create_dir (Filename.dirname fileName);
	let oc = open_out fileName in 
	List.iter (fun t -> binarize oc t) stream;
	flush oc;
	close_out oc

let read_bytecode fileName = 
	let ic = open_in_bin fileName
	in classify ic ;
	(* flush ? *)
	close_in ic
	
